home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DATETIME.SWG / 0052_Fast and Useful Date routines.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  4KB  |  169 lines
  1. {
  2.    Here you have my DayUtil, I'm sure you can use that instead. As a bonus you
  3. get a function that returns the daynumber of Eastern Day a certain year (yes!
  4. it's true! :) plus some other useful(?) related functions.
  5.  
  6.                            - = * = -
  7. }
  8.  
  9. unit DayUtil;
  10. { some useful date&time related functions }
  11. { PD by Björn Felten @ 2:203/208 -- Nov 1994 }
  12.  
  13. {$g+} { three shift instructions need this }
  14.  
  15. interface
  16.  
  17. function dayNo(Ye,Mo,Da:word): word; {calculate the daynumber 1..366}
  18. function easternDay(Ye:word): word;  {what day Eastern Day is that year}
  19. function getYear:  word; inline($b4/$2a/$cd/$21/$89/$c8);
  20. function getMonth: word; inline($b4/$2a/$cd/$21/$30/$e4/$88/$f0);
  21. function getDay:   word; inline($b4/$2a/$cd/$21/$30/$e4/$88/$d0);
  22. function getDow:   word; inline($b4/$2a/$cd/$21/$30/$e4);
  23. function getHour:  word; inline($b4/$2c/$cd/$21/$30/$e4/$88/$e8);
  24. function getMin:   word; inline($b4/$2c/$cd/$21/$30/$e4/$88/$c8);
  25. function getSec:   word; inline($b4/$2c/$cd/$21/$30/$e4/$88/$f0);
  26. function workDay(Ye,Mo,Da,Wd:word): boolean; {returns true if a working day}
  27.  
  28.  
  29. implementation
  30.  
  31. function dayNo;assembler;
  32. asm
  33.     mov  bx,Ye
  34.     mov  cx,Mo
  35.     dec  cx      (* Month = 0..11 *)
  36.     mov  di,Da
  37.  
  38. {   if Month>2 then  }
  39.     cmp  cx,1
  40.     jle  @janfeb
  41.  
  42. {      S := ((Year mod 4) + 3) div 4 + (4 * Month + 23) div 10 - 1  }
  43.     and  bx,3
  44.     add  bx,3
  45.     shr  bx,2
  46.     mov  ax,cx
  47.     inc  ax
  48.     shl  ax,2
  49.     add  ax,23
  50.     cwd
  51.     push cx
  52.     mov  cx,10
  53.     div  cx
  54.     pop  cx
  55.     dec  ax
  56.     add  bx,ax
  57.     jmp  @eif
  58.  
  59. {   else  }
  60. @janfeb:
  61.  
  62. {      S := 0;  }
  63.     xor  bx,bx
  64. @eif:
  65.  
  66. {   DayNo:= 31 * (Month - 1) + Day - S;  }
  67.     mov  ax,cx
  68.     mov  cx,31
  69.     mul  cx
  70.     add  ax,di
  71.     sub  ax,bx
  72. end;
  73.  
  74. function easternDay;assembler;
  75. { uses Gauss' Eastern formula to calculate Eastern Day }
  76. { you're not supposed to understand this... :) }
  77. { it took me quite some while to convert the "formula" from }
  78. { the look up tables, that I found in my encyclopaedia, into }
  79. { pure, working assembler, so enjoy... }
  80. asm
  81.     mov  ax,Ye
  82.     cmp  ax,99
  83.     jg   @noadd
  84.     cmp  ax,80
  85.     jg   @not2000
  86.     add  ax,100
  87. @not2000:
  88.     add  ax,1900
  89. @noadd:
  90.     mov  bx,ax
  91.     cwd
  92.     mov  cx,19
  93.     div  cx
  94.     mov  ax,dx
  95.     mul  cx
  96.     add  ax,24
  97.     mov  cx,30
  98.     div  cx
  99.     mov  si,dx
  100.     mov  ax,bx
  101.     and  ax,3
  102.     shl  ax,1
  103.     mov  di,ax
  104.     mov  ax,bx
  105.     cwd
  106.     mov  cx,7
  107.     div  cx
  108.     mov  ax,dx
  109.     shl  ax,2
  110.     add  di,ax
  111.     mov  ax,si
  112.     shl  ax,1
  113.     add  ax,si
  114.     shl  ax,1
  115.     add  ax,5
  116.     add  ax,di
  117.     cwd
  118.     div  cx
  119.     add  dx,si
  120.     add  dx,81
  121.     and  bx,3
  122.     jne  @no29
  123.     inc  dx
  124. @no29:
  125.     mov  ax,dx
  126. end;
  127.  
  128.  
  129. (*
  130.    (In other countries than Sweden you may have other holidays
  131.    than we have here. But you'll probably recognize Ascension Day,
  132.    Whit-Monday and the other holidays below, so it shouldn't
  133.    be that difficult to work out your own, country specific,
  134.    modifications to get the workDay function working properly...)
  135.  
  136.    För svenska förhållanden gäller följande beträffande helgdagar:
  137.  
  138.        Sun:=(WeekDay='S') or   {Söndag}
  139.       (ThisDate='01 Jan') or   {Nyårsdagen}
  140.       (ThisDate='06 Jan') or   {Trettondedagen}
  141.       (ThisDate='01 May') or   {1:sta maj}
  142.       (ThisDate='25 Dec') or   {Juldagen}
  143.       (ThisDate='26 Dec');     {Annandag jul}
  144.  
  145.        EFri:=EasternDay-2;     {Långfredag}
  146.        EMon:=EFri+3;           {Annandag påsk}
  147.        ADay:=EMon+38;          {Kristi himmelsfärdsdag}
  148.        WMon:=ADay+11;          {Annandag pingst}
  149. *)
  150.  
  151. function workDay;
  152. var dn,ed:word;
  153. begin
  154.   dn:=dayNo(Ye,Mo,Da); ed:=easternDay(Ye);
  155.   workDay:=not
  156.        ((Wd= 0) or(Wd= 6)  or   {Söndag eller Lördag}
  157.        ((Da= 1)and(Mo= 1)) or   {Nyårsdagen}
  158.        ((Da= 6)and(Mo= 1)) or   {Trettondedagen}
  159.        ((Da= 1)and(Mo= 5)) or   {1:sta maj}
  160.        ((Da=25)and(Mo=12)) or   {Juldagen}
  161.        ((Da=26)and(Mo=12)) or   {Annandag jul}
  162.         (dn=ed- 2)         or   {Långfredag}
  163.         (dn=ed+ 1)         or   {Annandag påsk}
  164.         (dn=ed+39)         or   {Kristi himmelsfärdsdag}
  165.         (dn=ed+50))             {Annandag pingst}
  166. end;
  167.  
  168. end.
  169.